perm filename KIEDIT.SAI[KI,ALS] blob
sn#095830 filedate 1974-04-10 generic text, type T, neo UTF8
00010 BEGIN "EDIT"
00020 DEFINE ⊂="COMMENT",CR="'15",LF="'12", CRLF="CR&LF",TB="'11";
00030 REQUIRE "DPYSUB.HDR[1,PDQ]" SOURCE_FILE;
00040 REQUIRE "KIPLA2.REL[KI,ALS]" LOAD_MODULE;
00050 REQUIRE "FIXUPA.REL[X,ALS]" LIBRARY;
00060 REQUIRE "IO.REL[X,ALS]" LIBRARY;
00070 REQUIRE "SUIO.REL[X,ALS]" LIBRARY;
00080 REQUIRE "LIB.REL[NET,NJM]" LIBRARY;
00090 EXTERNAL FORTRAN PROCEDURE KIPLAY;
00100 INTEGER ARRAY DPYBUF[0:8192];
00110 INTEGER ARRAY DATA[0:511];
00120 INTEGER ARRAY NAMES[0:100];
00130 INTEGER ARRAY DUMMY[1:2];
00140 INTEGER ARRAY NAME[0:5];
00150 INTEGER CHAN1,CHAN2,CHAN3,CHAN4,CHAN5,
00160 NEW,I,J,K,L,V,LP,EOF,PP,SEGNAM,POINTX,PT0,PT1,PT2;
00170 INTEGER ARRAY PT[0:8];
00180 STRING READ,READ2,READ3;
00190 BOOLEAN ER;
00200
00210 PROCEDURE SAY;
00220 BEGIN "SAY"
00230
00240 INTEGER I,J;
00250 STRING READ2,READ3;
00260
00270 READ3←"";
00280 FOR I←1 STEP 1 UNTIL 5 DO BEGIN
00290 FOR J←1 STEP 1 UNTIL 5 DO BEGIN
00300 READ3←READ3&READ[1 TO 1];
00310 READ←READ[2 TO 20];
00320 END;
00330 NAME[I]←CVASC(READ3);
00340 READ3←"";
00350 END;
00360
00370 START_CODE '047000400037; MOVEM 0,SEGNAM; '047040400017; END;
00380 ⊂ Get segment name and detach;
00390 KIPLAY(NAME[1],DUMMY[1]);
00400 START_CODE MOVE 0,SEGNAM; '047000400016; JFCL; END;
00410 ⊂ Reattach segment so exit will be in order;
00420 END "SAY";
00430
00440
00450 PROCEDURE SHUFFLE;
00460 BEGIN "SHUF"
00470 INTEGER I,J,K;
00480
00490 AIVECT(-640,386);
00500 I←DPYPTR-PT1; ⊂ Words to save;
00510 J←PT1-PT0; ⊂ Words to overwrite;
00520 for k←1 step 1 until i do dpybuf[k+3]←dpybuf[k+3+j];
00530 for k←i+1 step 1 until j+1 do dpybuf[k+3]←1;
00540 PT1←DPYPTR←PT0+I;
00550 END "SHUF";
00560
00570
00580 PROCEDURE PLOT;
00590 BEGIN "PLOT"
00600 INTEGER I,J,K,L,JP,LP,II,JJ,AA,BB;
00610
00620 WHILE EOF=0 DO BEGIN
00625 PTOCHW(0,'14127); ⊂ MAKE THE WHO LINE GO AWAY;
00630 TYPLOC(-330,-512); DPYSET(DPYBUF);
00640 AIVECT(-640,448); PT0←DPYPTR;
00650 CLOSE(CHAN3); OPEN(CHAN3,"DSK",'10,0,2,0,0,0);
00660 ENTER(CHAN3,"TMP1.TMP",0); READ←"TMP1.TMP";
00670 FOR I←0 STEP 1 UNTIL 5 DO BEGIN
00680 RIVECT(0,-JP); DPYSST(CVS(I)); RIVECT(0,JP);
00690 FOR J←1 STEP 1 UNTIL 5 DO BEGIN
00700 ARRYIN(CHAN1,DATA[0],512);
00710 ARRYOUT(CHAN3,DATA[0],512);
00720 FOR K←0 STEP 2 UNTIL 510 DO BEGIN
00730 L←LDB(POINT(12,DATA[K],11)); IF L>2047 THEN L←L-4096; L←L%16;
00740 LP←L-JP; RVECT(1,LP); JP←L;
00750 END;
00760 END;
00770 RIVECT(-647,-LP); RIVECT(-648,-128);
00780 PT[I]←DPYPTR;
00790 END;
00800
00810 RIVECT(0,50); DPYSST("0");
00820 FOR I←1 STEP 1 UNTIL 5 DO BEGIN
00830 RIVECT(226,0); DPYSST("."&CVS(I)); END;
00840 DPYOUT(0); PTOCHW(0,'10120);
00850 OUTSTR("Portion shown says-"&CRLF);
00860 CLOSE(CHAN3); SAY;
00870
00880 WHILE TRUE DO BEGIN "SAVE"
00890 OUTSTR("Start saving at (space for none, CR for all) ");
00900 IF (READ2←INCHWL)="" THEN BEGIN AA←0; BB←30; END
00910 ELSE IF READ2=" " THEN BB←0
00920 ELSE BEGIN READ3←READ2[1 TO 1]; READ2←READ2[3 TO 3];
00922 AA←(CVD(READ3))*5+CVD(READ2);
00925 OUTSTR("AA just set to "&CVS(AA)&CRLF);
00930 OUTSTR("Save to (CR if to 5:5) ");
00940 READ2←INCHWL;
00945 IF READ2="" THEN READ2←"5.5";
00950 BB←(CVD(READ2[1 TO 1]))*5+CVD(READ2[3 TO 3]); END;
00955 OUTSTR("Ready to LOOKUP CHAN3,TMP1,TMP "&CRLF);
00957 outstr("AA set at "&cvs(AA)&" BB set at "&CVS(BB)&CRLF);
00960 IF BB≠0 THEN BEGIN
00965 RELEASE(CHAN3);
00970 CLOSE(CHAN3); OPEN(CHAN3,"DSK",'10,2,0,0,0,EOF);
00975 OUTSTR("CHAN3 IS OPEN"&CRLF);
00980 LOOKUP(CHAN3,"TMP1,TMP",ER);
00985 OUTSTR("chan3 is open"&CRLF);
00990 IF AA≠0 THEN FOR I←0 STEP 1 UNTIL AA-1 DO
01000 ARRYIN(CHAN3,DATA[0],512);
01005 OUTSTR("unneeded portions discarded"&crlf);
01010 FOR I←AA STEP 1 UNTIL BB-1 DO BEGIN
01020 ARRYIN(CHAN3,DATA[0],512);
01030 ARRYOUT(CHAN4,DATA[0],512);
01040 END;
01050 END ELSE DONE;
01060 IF BB≥29 THEN DONE ELSE
01070 OUTSTR("You may append some more if you wish"&CRLF);
01080 END "SAVE";
01090 OUTSTR("Next section coming up."&CRLF);
01100 END;
01110 TYPLOC(512,-512);
01120
01130 END "PLOT";
00010 OUTSTR("This program allows one to hear a file, to edit it, to open a new file"
00020 &CRLF&TB&
00030 " and to add the new file name to the list (in sixbit) in file KILIST.SIX"&CRLF);
00040
00050 OUTSTR("A space only as old name is taken to mean LISTEN.TMP"&CRLF
00060 &"A ? will cause the list in KILIST.SIX to be typed"&CRLF
00070 &"A CR only terminates the session"&CRLF);
00080 CHAN1←1; CHAN2←2; CHAN3←3; CHAN4←4; chan5←5;
00090 START_CODE MOVE 0,['325004000000]; '047000400110; END;
00100
00110 CLOSE(CHAN2); OPEN (CHAN2,"DSK",'10,2,0,0,0,EOF);
00120 LOOKUP(CHAN2,"KILIST.SIX[KI,ALS]",ER);
00130 ARRYIN(CHAN2,NAMES[0],100);
00140
00150 WHILE TRUE DO BEGIN "LOOP"
00160 OUTSTR(CRLF&"Type the old file name (with extension) ");
00170 ER←1; WHILE ER DO BEGIN "OLD"
00180 IF ( READ←INCHWL)="" THEN DONE "LOOP";
00190 IF READ=" " THEN READ←"LISTEN.TMP";
00200
00210 IF READ="?" THEN BEGIN
00220 OUTSTR(CRLF& "The following files are listed)"&CRLF&LF);
00230 FOR I←0 STEP 1 UNTIL 99 DO BEGIN
00240 IF NAMES[I]=0 THEN DONE;
00250 OUTSTR(CVXSTR(NAMES[I])&".SAY"&CRLF);
00260 END;
00270 CONTINUE "LOOP";
00280 END;
00290
00300 CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,1,1,0,0,EOF);
00310 LOOKUP(CHAN1,READ,ER);
00320 IF ER THEN OUTSTR("File "&READ&" could not be found. "
00330 &CRLF&"Try again ")
00340 ELSE DONE;
00350 END "OLD";
00360
00370 SAY;
00010 WHILE TRUE DO BEGIN "NEWN"
00020 OUTSTR("Now type new name"&CRLF&
00030 " (CR for TMP.SAY, space to skip editing ");
00040 IF ( READ2←INCHWL)=" " THEN CONTINUE "LOOP";
00050 IF READ2="" THEN BEGIN READ3←"TMP"; DONE "NEWN"; END;
00060
00070 IF READ2="?" THEN BEGIN
00080 OUTSTR(CRLF& "The following files are listed)"&CRLF&LF);
00090 FOR I←0 STEP 1 UNTIL 99 DO BEGIN
00100 IF NAMES[I]=0 THEN DONE;
00110 OUTSTR(CVXSTR(NAMES[I])&".SAY"&CRLF);
00120 END;
00130 CONTINUE "NEWN";
00140 END;
00150
00160 READ3←"";
00170
00180 FOR I←0 STEP 1 UNTIL 5 DO BEGIN
00190 IF READ2[1 TO 1]="." THEN DONE;
00200 READ3←READ3&READ2[1 TO 1]; READ2←READ2[2 TO 5]; END;
00210
00220 NEW←CVSIX(READ3);
00230
00240 FOR I←0 STEP 1 UNTIL 99 DO BEGIN
00250 IF NAMES[I]=0 THEN BEGIN NAMES[I]←NEW; DONE "NEWN"; END;
00260 IF NAMES[I]=NEW THEN BEGIN
00270 OUTSTR("New name already has been used"
00280 &CRLF&"Try again or CR to void request "&CRLF);
00290 DONE;
00300 END;
00310 END;
00320 END "NEWN";
00330
00340 OUTSTR("New name is to be "&READ3&".SAY ."&CRLF);
00350 CLOSE(CHAN4); OPEN(CHAN4,"DSK",'10,0,2,0,0,0);
00360 ENTER(CHAN4 ,READ3&".SAY",0);
00370
00380 PLOT;
00390
00400 CLOSE(CHAN2); OPEN(CHAN2,"DSK",'10,0,2,0,0,0);
00410 ENTER(CHAN2,"KILIST.SIX[KI,ALS]",0);
00420 ARRYOUT(CHAN2,NAMES[0],100);
00430 CLOSE(CHAN2);
00440
00450 WHILE TRUE DO BEGIN
00460 OUTSTR("Do you eant to hear final product (Y or CR) ");
00470 IF INCHWL≠"" THEN BEGIN READ←READ3&".SAY"; SAY; END
00480 ELSE DONE; END;
00490
00500 END "LOOP";
00510
00520 START_CODE MOVE 0,['325000000000]; '047000400110; END;
00530
00540 RELEASE(CHAN1); RELEASE(CHAN2); RELEASE(CHAN3);
00550 RELEASE(CHAN4); RELEASE(CHAN5);
00560 END "EDIT";